home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH6 / SRC / BEZIER.FRM < prev    next >
Text File  |  1996-03-30  |  8KB  |  293 lines
  1. VERSION 4.00
  2. Begin VB.Form BezierForm 
  3.    Caption         =   "Bezier Curve"
  4.    ClientHeight    =   5490
  5.    ClientLeft      =   2175
  6.    ClientTop       =   930
  7.    ClientWidth     =   4830
  8.    Height          =   6180
  9.    Left            =   2115
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   366
  12.    ScaleMode       =   3  'Pixel
  13.    ScaleWidth      =   322
  14.    Top             =   300
  15.    Width           =   4950
  16.    Begin VB.CommandButton CmdGo 
  17.       Caption         =   "Go"
  18.       Height          =   375
  19.       Left            =   4320
  20.       TabIndex        =   4
  21.       Top             =   0
  22.       Width           =   495
  23.    End
  24.    Begin VB.CheckBox ControlCheck 
  25.       Caption         =   "Show Control Points"
  26.       Height          =   255
  27.       Left            =   1080
  28.       TabIndex        =   3
  29.       Top             =   60
  30.       Value           =   1  'Checked
  31.       Width           =   1815
  32.    End
  33.    Begin VB.TextBox DtText 
  34.       Height          =   285
  35.       Left            =   240
  36.       TabIndex        =   2
  37.       Text            =   "0.01"
  38.       Top             =   45
  39.       Width           =   615
  40.    End
  41.    Begin VB.PictureBox Canvas 
  42.       AutoRedraw      =   -1  'True
  43.       Height          =   4815
  44.       Left            =   0
  45.       ScaleHeight     =   317
  46.       ScaleMode       =   3  'Pixel
  47.       ScaleWidth      =   317
  48.       TabIndex        =   0
  49.       Top             =   480
  50.       Width           =   4815
  51.    End
  52.    Begin VB.Label Label1 
  53.       Caption         =   "dt"
  54.       Height          =   255
  55.       Index           =   1
  56.       Left            =   0
  57.       TabIndex        =   1
  58.       Top             =   60
  59.       Width           =   255
  60.    End
  61.    Begin VB.Menu mnuFile 
  62.       Caption         =   "&File"
  63.       Begin VB.Menu mnuFileExit 
  64.          Caption         =   "E&xit"
  65.       End
  66.    End
  67. End
  68. Attribute VB_Name = "BezierForm"
  69. Attribute VB_Creatable = False
  70. Attribute VB_Exposed = False
  71. Option Explicit
  72.  
  73. Const PI = 3.14159
  74.  
  75. Const GAP = 3
  76.  
  77. ' The endpoints are points 1 and 4. The control
  78. ' points are points 2 and 3.
  79. Const NumPts = 4
  80. Dim PtX(1 To NumPts) As Single
  81. Dim PtY(1 To NumPts) As Single
  82.  
  83. ' The index of the point being dragged.
  84. Dim Dragging As Integer
  85.  
  86. Dim OldMode As Integer
  87.  
  88. ' The Bezier curve parameters.
  89. Dim Ax As Single
  90. Dim Bx As Single
  91. Dim Cx As Single
  92. Dim Dx As Single
  93. Dim Ay As Single
  94. Dim By As Single
  95. Dim Cy As Single
  96. Dim Dy As Single
  97.  
  98.  
  99. ' ************************************************
  100. ' Draw the curve on the indicated picture box.
  101. ' ************************************************
  102. Sub DrawCurve(pic As PictureBox, start_t As Single, stop_t As Single, dt As Single)
  103. Dim x1 As Single
  104. Dim y1 As Single
  105. Dim t As Single
  106.  
  107.     x1 = X(start_t)
  108.     y1 = Y(start_t)
  109.     pic.Cls
  110.     pic.CurrentX = x1
  111.     pic.CurrentY = y1
  112.     
  113.     t = start_t + dt
  114.     Do While t < stop_t
  115.         x1 = X(t)
  116.         y1 = Y(t)
  117.         pic.Line -(x1, y1)
  118.         t = t + dt
  119.     Loop
  120.     
  121.     x1 = X(stop_t)
  122.     y1 = Y(stop_t)
  123.     pic.Line -(x1, y1)
  124. End Sub
  125. ' ************************************************
  126. ' Compute the Bezier curve parameters.
  127. ' ************************************************
  128. Sub GetBezierValues(ex1 As Single, ey1 As Single, ex2 As Single, ey2 As Single, x1 As Single, y1 As Single, x2 As Single, y2 As Single, Ax As Single, Bx As Single, Cx As Single, Dx As Single, Ay As Single, By As Single, Cy As Single, Dy As Single)
  129.     Ax = ex2 - ex1 - 3 * x2 + 3 * x1
  130.     Bx = 3 * ex1 - 6 * x1 + 3 * x2
  131.     Cx = -3 * ex1 + 3 * x1
  132.     Dx = ex1
  133.     
  134.     Ay = ey2 - ey1 - 3 * y2 + 3 * y1
  135.     By = 3 * ey1 - 6 * y1 + 3 * y2
  136.     Cy = -3 * ey1 + 3 * y1
  137.     Dy = ey1
  138. End Sub
  139.  
  140.  
  141.  
  142. ' ************************************************
  143. ' The parametric function Y(t).
  144. ' ************************************************
  145. Function Y(t As Single) As Single
  146.     Y = Ay * t ^ 3 + By * t * t + Cy * t + Dy
  147. End Function
  148.  
  149. ' ************************************************
  150. ' The parametric function X(t).
  151. ' ************************************************
  152. Function X(t As Single) As Single
  153.     X = Ax * t ^ 3 + Bx * t * t + Cx * t + Dx
  154. End Function
  155.  
  156. ' ************************************************
  157. ' Prepare to draw the Bezier curve.
  158. ' ************************************************
  159. Private Sub DrawBezier()
  160. Const DOTTED = 2
  161.  
  162. Dim dt As Single
  163. Dim i As Integer
  164.  
  165.     ' Compute the curve parameters.
  166.     GetBezierValues _
  167.         PtX(1), PtY(1), _
  168.         PtX(4), PtY(4), _
  169.         PtX(2), PtY(2), _
  170.         PtX(3), PtY(3), _
  171.         Ax, Bx, Cx, Dx, Ay, By, Cy, Dy
  172.     
  173.     ' Draw the curve.
  174.     dt = CSng(DtText.Text)
  175.     DrawCurve Canvas, 0, 1, dt
  176.  
  177.     If ControlCheck.Value = vbChecked Then
  178.         ' Draw the control points.
  179.         For i = 1 To NumPts
  180.             Canvas.Line _
  181.                 (PtX(i) - GAP, PtY(i) - GAP)- _
  182.                 Step(2 * GAP, 2 * GAP), , BF
  183.         Next i
  184.         
  185.         ' Connect the control points.
  186.         OldMode = Canvas.DrawStyle
  187.         Canvas.DrawStyle = DOTTED
  188.         Canvas.CurrentX = PtX(1)
  189.         Canvas.CurrentY = PtY(1)
  190.         For i = 2 To NumPts
  191.             Canvas.Line -(PtX(i), PtY(i))
  192.         Next i
  193.         Canvas.DrawStyle = OldMode
  194.     End If
  195. End Sub
  196.  
  197. ' ************************************************
  198. ' Select a point and start dragging it.
  199. ' ************************************************
  200. Private Sub Canvas_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  201. Dim i As Integer
  202.  
  203.     ' Find a close point.
  204.     For i = 1 To NumPts
  205.         If Abs(PtX(i) - X) <= GAP And _
  206.            Abs(PtY(i) - Y) <= GAP Then Exit For
  207.     Next i
  208.     If i > NumPts Then Exit Sub
  209.  
  210.     Dragging = i
  211.     OldMode = Canvas.DrawMode
  212.     Canvas.DrawMode = vbInvert
  213.     PtX(Dragging) = X
  214.     PtY(Dragging) = Y
  215.     Canvas.Line _
  216.         (PtX(Dragging) - GAP, PtY(Dragging) - GAP)- _
  217.         Step(2 * GAP, 2 * GAP), , BF
  218. End Sub
  219.  
  220.  
  221. ' ************************************************
  222. ' Continue dragging a point.
  223. ' ************************************************
  224. Private Sub Canvas_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  225.     If Dragging < 1 Then Exit Sub
  226.     
  227.     Canvas.Line _
  228.         (PtX(Dragging) - GAP, PtY(Dragging) - GAP)- _
  229.         Step(2 * GAP, 2 * GAP), , BF
  230.     
  231.     PtX(Dragging) = X
  232.     PtY(Dragging) = Y
  233.     
  234.     Canvas.Line _
  235.         (PtX(Dragging) - GAP, PtY(Dragging) - GAP)- _
  236.         Step(2 * GAP, 2 * GAP), , BF
  237. End Sub
  238.  
  239.  
  240. ' ************************************************
  241. ' Finish the drag and redraw the curve.
  242. ' ************************************************
  243. Private Sub Canvas_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  244.     If Dragging < 1 Then Exit Sub
  245.     
  246.     Canvas.DrawMode = OldMode
  247.     
  248.     PtX(Dragging) = X
  249.     PtY(Dragging) = Y
  250.     Dragging = 0
  251.     
  252.     DrawBezier
  253. End Sub
  254.  
  255.  
  256.  
  257.  
  258. Private Sub CmdGo_Click()
  259.     DrawBezier
  260. End Sub
  261.  
  262. Private Sub ControlCheck_Click()
  263.     DrawBezier
  264. End Sub
  265.  
  266. Private Sub Form_Load()
  267.     PtX(1) = 0.4 * Canvas.ScaleWidth
  268.     PtX(2) = 0.1 * Canvas.ScaleWidth
  269.     PtX(3) = 0.8 * Canvas.ScaleWidth
  270.     PtX(4) = 0.6 * Canvas.ScaleWidth
  271.     PtY(1) = 0.8 * Canvas.ScaleHeight
  272.     PtY(2) = 0.3 * Canvas.ScaleHeight
  273.     PtY(3) = 0.2 * Canvas.ScaleHeight
  274.     PtY(4) = 0.7 * Canvas.ScaleHeight
  275. End Sub
  276.  
  277. ' ************************************************
  278. ' Make the canvas as big as possible.
  279. ' ************************************************
  280. Private Sub Form_Resize()
  281.     Canvas.Move 0, Canvas.Top, _
  282.         ScaleWidth, ScaleHeight - Canvas.Top
  283.         
  284.     DrawBezier
  285. End Sub
  286.  
  287.  
  288. Private Sub mnuFileExit_Click()
  289.     Unload Me
  290. End Sub
  291.  
  292.  
  293.